perm filename RENAM.FAI[SCR,LCS] blob
sn#308337 filedate 1977-10-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY RENAM,FINDIT
C00005 ENDMK
C⊗;
ENTRY RENAM,FINDIT
A←1 ↔ B←2 ↔ C←3 ↔ P←17 ↔ SVN ← 4 ↔ CHN ← 11
;RENAME FOR FORTRAN
; CALL(OLDNAME,OLDEXT,NEWNAME,NEWEXT)
; HALTS ON ERROR OR FILE NOT FOUND
RENAM: 0
HRRZI REGS
BLT REGS+4
EXCH P,SVP
GONE: MOVE SVN,@(16) ;FIRST FILE NAME
MOVE B,[POINT 6,NAME]
PUSHJ P,SEVN26
MOVE SVN,@1(16) ;FIRST EXT
MOVE B,[POINT 6,NAME+1]
PUSHJ P,SEVN26
SETZM NAME+3 ;NO PPN
OPEN CHN,[14↔'DSK '↔0]
JRST ERROR
LOOKUP CHN,NAME
JRST ERROR
MOVE SVN,@2(16) ;SECOND FILE NAME
MOVE B,[POINT 6,NAME]
PUSHJ P,SEVN26
MOVE SVN,@3(16) ;SECOND EXT
MOVE B,[POINT 6,NAME+1]
PUSHJ P,SEVN26
SETZM NAME+3 ;NO PPN??
RENAME CHN,NAME
JRST CKDEL ;CHECK FOR OLD FILE
HRLZI REGS
BLT 4
EXCH P,SVP
JRA 16,4(16)
SEVN26: MOVE A,[POINT 7,SVN] ;SEVEN TO SIXBIT
SETZM (B)
MOVEI C,5
SIXOOP: ILDB A
CAIN " "
POPJ P,
SUBI 40
IDPB B
SOJG C,SIXOOP
POPJ P,
CKDEL: HRRZ NAME+1
CAIE 4 ;SEE IF FILE EXISTS
JRST ERROR
OPEN 12,[14↔'DSK '↔0]
JRST ERROR
SETZM NAME+3
LOOKUP 12,NAME
JRST ERROR
SETZM NAME
RENAME 12,NAME ;DELETE IT
JRST 4,.
JRST GONE
ERROR: ;GETS HERE IF ERROR OR FILE NOT FOUND
JRST 4,. ;HALT
NAME: BLOCK 4
REGS: BLOCK 5
SVP: -10,,PDL
PDL: BLOCK 10
;FUNCTION FINDIT(NAME) LOOKS UP 'NAME.SCR'
FINDIT: 0
HRRZI REGS
BLT REGS+4
EXCH P,SVP
MOVE SVN,@(16) ;MAKE 6-BIT
MOVE B,[POINT 6,NAME]
PUSHJ P,SEVN26
;; MOVE SVN,@1(16) ;FIRST EXT
;; MOVE B,[POINT 6,NAME+1]
MOVE B,[SIXBIT/SCR/]
MOVEM B,NAME+1
SETZM NAME+3 ;NO PPN
OPEN CHN,[14↔'DSK '↔0]
JRST ERROR
SETZ 0,
LOOKUP CHN,NAME
SETO 0, ;AC0=-1 FOR NOT FOUND
JRA 16,1(16)
END